home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.A.po / FEATURES:BEAGLE / TYPEFACES.SHK / TYPEFACES / FONT DISPLAY.bas < prev    next >
BASIC Source File  |  2000-01-01  |  6KB  |  53 lines
  1. 80  REM <CTRL-M><CTRL-M><CTRL-M>==========================<CTRL-M>SHAPE-FONT DISPLAY UTILITY<CTRL-M>BY BERT KERSEY<CTRL-M>(C) 1982, BEAGLE BROS<CTRL-M><CTRL-M>(SEE INSTRUCTIONS)<CTRL-M>==========================<CTRL-M><CTRL-M>
  2. 81 V$ = "9/1/84"
  3. 82  PRINT  CHR$(21)
  4. 90 CODE$ = "]MINI": REM NAME.OF.CODE.FONT
  5. 91  TEXT : HOME : INVERSE :A$ = " APPLE MECHANIC TYPEFACES ": PRINT  SPC(  LEN(A$)): PRINT : PRINT A$: PRINT  SPC(  LEN(A$)): PRINT : NORMAL 
  6. 92  PRINT : PRINT "COPYRIGHT (C) 1982, BERT KERSEY": PRINT : PRINT "BEAGLE BROS MICRO SOFTWARE, INC.": PRINT "3990 OLD TOWN AVENUE": PRINT "SAN DIEGO, CALIFORNIA 92110": PRINT 
  7. 93  PRINT V$: PRINT : FOR I = 1 TO 40: PRINT "-";: NEXT :
  8. 95 Q$ =  CHR$(34): PRINT : PRINT "TO SEE A SELECTED ]FONT,                INSERT DISK AND PRESS <RETURN>": PRINT : PRINT "OR TYPE "Q$"F"Q$" TO SEE FONT SAMPLER.": PRINT "OR TYPE "Q$"Q"Q$" TO QUIT."
  9. 96  PRINT : PRINT "SELECT:";: GET A$: PRINT A$: IF A$ = "Q"  THEN  VTAB 23: END 
  10. 97  IF A$ = "F"  THEN  HOME : HGR : POKE 49234,0: PRINT  CHR$(4);"BLOAD @FONT SAMPLER": POKE 49235,0: VTAB 23: PRINT "   (HIT <RESET> TO CLEAR THE SCREEN.)": FOR I = 1 TO 2000: NEXT : POKE 49234,0: END 
  11. 98  IF A$ < > CHR$(13)  THEN  RUN 
  12. 100  POKE 230,32: ROT= 0: SCALE= 1: DIM A$(34): PRINT  CHR$(4);"MONICO":SP = 32:F0 = 128:Q = 49152:CL = 49168:Z =  -958: GOTO 330
  13. 110  REM <CTRL-M><CTRL-M>DISPLAY FONT<CTRL-M>------------
  14. 120  HCOLOR= 0: HPLOT 0,0: CALL  -3082: HCOLOR= 3: FOR I = 1 TO 279  STEP 7: HPLOT I,163 TO I +4,163: NEXT :KFLAG = 0: POKE 49234,0: POKE 49239,0: POKE 49232,0: POKE 232,0: POKE 233,80: XDRAW  ASC(A$) -31 AT 0,175: FOR I = 2 TO  LEN(A$): XDRAW 99: XDRAW  ASC( MID$ (A$,I,1)) -31: NEXT 
  15. 130  FOR I = 1 TO 999: NEXT : FOR I = 1 TO 96:J = I -1: XDRAW I AT 17 *(J - INT(J/16) *16),27 * INT(J/16) +8: NEXT 
  16. 140  VTAB 21: HTAB 1: GOSUB 460: INVERSE : PRINT  LEFT$(A$,16);: CALL Z: NORMAL : HTAB 19: PRINT "<C> CHARACTER CODES": HTAB 19: PRINT "<M> MENU": PRINT "SELECT:";: HTAB 17: PRINT "<ESC> QUIT";: POKE 2007,96: IF KFLAG  THEN  VTAB 22: HTAB 23: PRINT "CHANGE/ERASE CODES"
  17. 150  IF CFLAG  THEN  VTAB 22: HTAB 21: CALL  -868
  18. 160  FOR I = 1 TO 999: NEXT : POKE  -16301,0
  19. 170 K =  PEEK(Q): IF K < >205  AND K < >155  AND K < >195  THEN 170
  20. 180  IF K = 195  AND CFLAG = 1  THEN 170
  21. 190 N$ = "": POKE CL,0: VTAB 24: HTAB 8: PRINT  CHR$(K);: IF K = 155  THEN  POKE 34,0: VTAB 22: HTAB 1: CALL Z: END 
  22. 200  IF K = 195  AND KFLAG = 0  THEN  VTAB 22: HTAB 18: CALL Z: VTAB 23: HTAB 18: PRINT "<K> KEYBOARD CHARACTERSADD K OR S?      <S> SHAPE NUMBERS";: HTAB 12: GET N$: PRINT N$;: IF N$ < >"K"  AND N$ < >"S"  THEN 200
  23. 210  IF N$ = "S"  AND KFLAG = 0  THEN KFLAG = 1: POKE 233,0: POKE 233,64: FOR I = 1 TO 96:N$ =  LEFT$( STR$(I) +" ",2):J = I -1: XDRAW  ASC(N$) -31 AT 17 *(J - INT(J/16) *16),27 * INT(J/16): XDRAW 99: XDRAW  ASC( RIGHT$(N$,1)) -31: NEXT : GOTO 140
  24. 220  IF N$ = "K"  AND KFLAG = 0  THEN KFLAG = 1: POKE 232,0: POKE 233,64: FOR I = 1 TO 96:J = I -1: XDRAW I AT 17 *(J - INT(J/16) *16),27 * INT(J/16): NEXT : GOTO 140
  25. 230  IF K = 195  AND KFLAG = 1  THEN KFLAG = 0: HCOLOR= 0: FOR J = 0 TO 7: FOR I = 0 TO 159  STEP 27: HPLOT 0,I +J TO 279,I +J: NEXT : NEXT : GOTO 140
  26. 240  TEXT : GOTO 260
  27. 250  REM <CTRL-M><CTRL-M>MENU<CTRL-M>----
  28. 260  VTAB 22: HTAB 1: POKE 34,21: CALL Z: PRINT : PRINT "< > SELECT FONT FOR DISPLAY   (ESC=QUIT)";: VTAB 23: HTAB 2: FLASH : PRINT " ";: NORMAL : HTAB 2
  29. 270 K =  PEEK(Q): IF K < >155  AND (K <192  OR K >218)  AND (K <177  OR K >183)  THEN 270
  30. 280  POKE CL,0: VTAB 23: HTAB 1: CALL Z: IF K = 155  THEN  TEXT : VTAB 23: HTAB 1: CALL Z: END 
  31. 290  VTAB 22: HTAB 1: CALL Z: PRINT :II = (K -192 +42 *(K <192)):A$ = A$(II): IF   NOT  LEN(A$)  THEN 260
  32. 300  VTAB 22: CALL Z: IF A$ < >O$  THEN O$ = A$: PRINT  CHR$(4)"BLOAD ";A$;"   ,A$5000"
  33. 310  GOTO 120
  34. 320  REM <CTRL-M><CTRL-M>READ CATALOG<CTRL-M>------------
  35. 330  ONERR  GOTO 350
  36. 340  TEXT : HOME : NORMAL : VTAB 22: PRINT : PRINT  CHR$(4)"BLOAD "CODE$",A$4000": GOTO 360
  37. 350  PRINT : PRINT "FILE NOT FOUND"; CHR$(7): FOR I = 1 TO 999: NEXT :CFLAG = 1
  38. 360  POKE 768,32: POKE 769,227: POKE 770,3: POKE 771,76: POKE 772,217: POKE 773,3: POKE 47092,1: POKE 47083,0: POKE 47091,0: POKE 47084,17: POKE 47088,0: POKE 47089,32:LO = 8192
  39. 370  HOME : INVERSE : PRINT : PRINT " APPLE MECHANIC TYPEFACES ": NORMAL : GOSUB 460: VTAB 21: GOSUB 460: FOR I = 1 TO 17: VTAB I +3: PRINT "<" CHR$(I +64)">" SPC( 17)"<" CHR$(I +81 -42 *(I +17 >26))">": NEXT : FOR I = 1 TO 29:S$ = S$ +" ": NEXT : ONERR  GOTO 470
  40. 380  FOR SE = 15 TO 1  STEP  -1: POKE 47085,SE: CALL 768: FOR X = LO +11 TO LO +221  STEP 35: IF  PEEK(X) = 0  THEN 430
  41. 390  IF  PEEK(X) = 255  OR  PEEK(X +3) < >221  OR ( PEEK(X +2) < >4  AND  PEEK(X +2) < >132)  THEN 420
  42. 400 FI = FI +1: FOR Y = X +3 TO X +32  STEP 2:P1 =  PEEK(Y) -F0:P2 =  PEEK(Y +1) -F0: IF P1 < >SP  OR P2 < >SP  THEN A$(FI) = A$(FI) + CHR$(P1) + CHR$(P2): NEXT 
  43. 410  VTAB FI +3 -17 *(FI >17): HTAB 4 +20 *(FI >17): PRINT  LEFT$(A$(FI),16): IF FI = 34  THEN 450
  44. 420  NEXT X,SE
  45. 430  IF FI <34  THEN  FOR I = FI +1 TO 34: VTAB I +3 -17 *(I >17): HTAB 1 +19 *(I >17): CALL  -868: NEXT 
  46. 440  FOR I = 1 TO FI:A$(I) =  LEFT$(A$(I) +S$,30): NEXT 
  47. 450  GOTO 260
  48. 460  FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN 
  49. 465  REM <CTRL-M><CTRL-M>ERROR TRAP<CTRL-M>----------
  50. 470  PRINT  CHR$(7);: VTAB 22: HTAB 1: CALL Z: PRINT : IF  PEEK(222) = 6  THEN  INVERSE : PRINT " "A$" NOT FOUND ";: NORMAL : FOR I = 1 TO 999: NEXT : GOTO 500
  51. 480  IF  PEEK(222) = 255  THEN  POKE 34,0: VTAB 23: END 
  52. 490  PRINT "ERROR"
  53. 500 A$ = "":O$ = A$: FOR I = 1 TO 999: NEXT : GOTO 260